home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
edierebi.mod
< prev
next >
Wrap
Text File
|
1995-11-25
|
11KB
|
340 lines
IMPLEMENTATION MODULE EdiereBierListe;
(********************** IMPORT ***************************************)
FROM BlRscInc IMPORT SaveFileName, EINGABE(* TREE *), NAME, UEBERTRG, BSTRICH,
LSTRICH, PREVIOUS, NEXT, CANCLABR, OKABR,LOESCHEN ;(* OBJECTs in TREE #4 *)
FROM SYSTEM IMPORT VAL,ADDRESS;
FROM AES IMPORT FormAlert,ResourceGetAddr;
FROM EasyDialog IMPORT DoMoveDialog,and,GetText,SetText,IsSelected;
FROM ConvertStr IMPORT StrToInt, StrToLongInt,IntToStr,LongIntToStr;
FROM Strings IMPORT ClearStr,IsEmptyStr,EqualStr,LeftStr,SubStr,Length,
Concat;
FROM Bliste IMPORT List,AtFirst,AtLast,Empty,Next,Prev,AppendElement,RemoveElement,Kunde,
First,MakeList,KillList,GetValue,SetValue,STRING15;
FROM XStrings IMPORT FillStr;
FROM PreisErfassung IMPORT VerkaufsPreis;
FROM InOut IMPORT WriteString,WriteLn,WriteInt,ReadInt,Done,
ReadLine;(* OpenOutput,CloseOutput,OpenInput,CloseInput;*)
FROM LongInOut IMPORT WriteLongInt,ReadLongInt;
(******************************** VAR **********************************)
VAR AlertString1,
AlertString2,
AlertString3,
AlertString5,
AlertString6,
AlertString4 :ARRAY [0..127] OF CHAR;
NewStr : STRING15;
Customer :Kunde;
(******************************* BEGIN PROCEDUREs ***********************)
PROCEDURE ComputeCustomer;
VAR OK:BOOLEAN;
BEGIN
OK:=GetValue(BierListe,Customer);
Customer.Rechnung:=
Customer.Uebertrag+
VAL(LONGINT,(Customer.Biere*VerkaufsPreis.BierPreis))+
VAL(LONGINT,(Customer.Limos*VerkaufsPreis.LimoPreis));
SetValue(BierListe,Customer);
END ComputeCustomer;
PROCEDURE SaveCustomer;
BEGIN
ComputeCustomer;
WriteString(Customer.Name);
WriteLn;
WriteLongInt(Customer.Uebertrag,10);
WriteInt(Customer.Biere,5);
WriteInt(Customer.Limos,5);
WriteLongInt(Customer.Rechnung,10);
WriteInt(Customer.BiereIsg,5);
WriteInt(Customer.LimosIsg,5);
WriteLongInt(Customer.Umsatz,10);
WriteLn;
END SaveCustomer;
PROCEDURE LoadCustomerOld():BOOLEAN;
VAR LIdummy:LONGINT;
Idummy :INTEGER;
BEGIN
ReadLine(Customer.Name);
ReadLongInt(Customer.Uebertrag);
ReadInt(Customer.Biere);
ReadInt(Customer.Limos);
ReadLongInt(Customer.Rechnung);
ReadInt(Customer.BiereIsg);
ReadInt(Customer.LimosIsg);
ReadLongInt(Customer.Umsatz);
RETURN Done;
END LoadCustomerOld;
PROCEDURE LoadCustomer():BOOLEAN;
VAR LIdummy:LONGINT;
BisgDummy,
LisgDummy :INTEGER;
BEGIN
ReadLine(Customer.Name);
ReadLongInt(LIdummy);(* alter Übertrag*)
(** Weil die Werte nicht geladen werden, mit 0 belegen*)
Customer.Rechnung:=0; Customer.Biere:=0; Customer.Limos:=0;
ReadInt(BisgDummy); (* Biere beiletzter Rechnung *)
ReadInt(LisgDummy); (* Limos bei letzter Rechnung *)
ReadLongInt(Customer.Uebertrag);(* Alte Rechnung = NeuerÜbertrag*)
ReadInt(Customer.BiereIsg);
Customer.BiereIsg:=Customer.BiereIsg+BisgDummy;
ReadInt(Customer.LimosIsg);
Customer.LimosIsg:=Customer.LimosIsg+LisgDummy;
ReadLongInt(Customer.Umsatz);
Customer.Umsatz:= Customer.Umsatz+Customer.Rechnung;
RETURN Done
END LoadCustomer;
PROCEDURE SaveList;
VAR OK :BOOLEAN;
BEGIN
First(BierListe);
WHILE ~AtLast(BierListe) DO
OK:=GetValue(BierListe,Customer);
SaveCustomer;
Next(BierListe);
END(*WHILE*);
OK:=GetValue(BierListe,Customer);
(*der letzte auch noch*)
SaveCustomer;
END SaveList;
PROCEDURE LoadList;
VAR OK: BOOLEAN;
BEGIN
KillList(BierListe);
MakeList(BierListe);
AnfangsUebertrag:=0D;
IF Done THEN
WHILE LoadCustomer() DO
AppendElement(BierListe);
SetValue(BierListe,Customer);
AnfangsUebertrag:= AnfangsUebertrag+Customer.Uebertrag;
END(*WHILE*);
END(*IF*);
END LoadList;
PROCEDURE LoadOldList;
BEGIN
KillList(BierListe);
MakeList(BierListe);
AnfangsUebertrag:=0D;
IF Done THEN
WHILE LoadCustomerOld() DO
AppendElement(BierListe);
SetValue(BierListe,Customer);
AnfangsUebertrag:= AnfangsUebertrag+Customer.Uebertrag;
END(*WHILE*);
END(*IF*);
END LoadOldList;
PROCEDURE Editiere;
VAR EingabeDialogAddr :ADDRESS;
DiaReturn,i,
FormRet :INTEGER;
String :STRING15;
String7 :ARRAY [0..6] OF CHAR;
UEString :ARRAY [0..4] OF CHAR;
BSString :ARRAY [0..1] OF CHAR;
LSString :ARRAY [0..1] OF CHAR;
Null :ARRAY [0..0] OF CHAR;
New,OK :BOOLEAN;
PROCEDURE ValidInput():BOOLEAN;
VAR VglStr1,
VglStr2 : ARRAY[0..17] OF CHAR;
IntStr : ARRAY[0..1] OF CHAR;
OK : BOOLEAN;
Pf : LONGINT;
StringLaenge,BierStriche,LimoStriche:INTEGER;
BEGIN
VglStr1:='';VglStr2:='';
BierStriche:=0;Pf:=0;LimoStriche:=0;
IF IsEmptyStr(String) THEN RETURN FALSE END(*IF*);
LeftStr(String,15,VglStr1,OK);
IF IsEmptyStr(VglStr1) THEN RETURN FALSE END(*IF*);
VglStr2:='_________________';
LeftStr(VglStr2,15,VglStr2,OK);
IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
VglStr2:=' ';
LeftStr(VglStr2,15,VglStr2,OK);
IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
StrToLongInt(UEString,Pf,OK);
StrToInt(BSString,BierStriche,OK);
StrToInt(LSString,LimoStriche,OK);
(************
WriteLongInt(Pf,5);WriteInt(BierStriche,5);WriteInt(LimoStriche,5);WriteLn;
**************)
IF New THEN
Customer.Rechnung:=0;
Customer.BiereIsg:=0;
Customer.LimosIsg:=0;
Customer.Umsatz:=0;
ELSE
OK:=GetValue(BierListe,Customer);
StringLaenge:=Length(Customer.Name);
LeftStr(VglStr1,StringLaenge,VglStr1,OK);
IF ~EqualStr(VglStr1,Customer.Name) THEN
FormRet:=FormAlert(1,AlertString4);
IF FormRet#1 THEN
RETURN FALSE
ELSE
New:=TRUE
END(*IF*);
END(*IF*);
END(*IF*);
IF New THEN
Customer.Name:=String;
END(*IF*);
Customer.Uebertrag:=Pf;
Customer.Biere:=BierStriche;
Customer.Limos:=LimoStriche;
SetValue(BierListe,Customer);
RETURN TRUE
END ValidInput;
BEGIN
ResourceGetAddr(0,EINGABE,EingabeDialogAddr);
Null[0]:='0';
IF Empty(BierListe) THEN
AppendElement(BierListe);
Customer.Name:=NewStr;
Customer.Uebertrag:=0D;
Customer.Biere:=0;
Customer.Limos:=0;
Customer.Rechnung:=0D;
Customer.BiereIsg:=0;
Customer.LimosIsg:=0;
Customer.Umsatz:=0D;
SetValue(BierListe,Customer);
New:=TRUE;
ELSE
First(BierListe);
New:=FALSE
END(*IF*);
REPEAT
IF ~New THEN
OK:=GetValue(BierListe,Customer);
SetText(NAME,EingabeDialogAddr,Customer.Name);
IntToStr(Customer.Biere,3,String7,OK);
SubStr(String7,2,2,String7,OK);
WHILE Length(String7)<2 DO
Concat(Null,String7,String7,OK);
END(*WHILE*);
SubStr(String7,0,2,BSString,OK);
SetText(BSTRICH,EingabeDialogAddr,BSString);
LongIntToStr(Customer.Limos,3,String7,OK);
SubStr(String7,2,2,String7,OK);
WHILE Length(String7)<2 DO
Concat(Null,String7,String7,OK);
END(*WHILE*);
SubStr(String7,0,2,LSString,OK);
SetText(LSTRICH,EingabeDialogAddr,LSString);
IntToStr(Customer.Uebertrag,3,String7,OK);
SubStr(String7,2,5,String7,OK);
WHILE Length(String7)<5 DO
Concat(Null,String7,String7,OK);
END(*WHILE*);
SubStr(String7,0,5,UEString,OK);
SetText(UEBERTRG,EingabeDialogAddr,UEString);
ELSE
(* SetText(NAME,EingabeDialogAddr,'________________');*)
SetText(NAME,EingabeDialogAddr,0C);
SetText(UEBERTRG,EingabeDialogAddr,0C);
SetText(BSTRICH,EingabeDialogAddr,0C);
SetText(LSTRICH,EingabeDialogAddr,0C);
END(*IF*);
DiaReturn:=DoMoveDialog(EingabeDialogAddr,NAME);
GetText(NAME,EingabeDialogAddr,String);
GetText(UEBERTRG,EingabeDialogAddr,UEString);
GetText(BSTRICH,EingabeDialogAddr,BSString);
GetText(LSTRICH,EingabeDialogAddr,LSString);
IF DiaReturn=LOESCHEN THEN
FormRet:=FormAlert(2,AlertString5);
IF FormRet=1 THEN
RemoveElement(BierListe);
New:=FALSE
END(*IF*);
ELSIF DiaReturn#CANCLABR THEN
IF ValidInput() THEN
IF DiaReturn=PREVIOUS THEN
IF ~Empty(BierListe) THEN
New:=FALSE;
IF AtFirst(BierListe) THEN
FormRet:=FormAlert(1,AlertString2);
ELSE
Prev(BierListe);
END(*IF*);
ELSE
New:=TRUE
END(*IF*);
ELSIF DiaReturn=NEXT THEN
IF AtLast(BierListe) THEN
FormRet:=FormAlert(1,AlertString3);
IF FormRet=1 THEN
AppendElement(BierListe);
Customer.Name:=NewStr;
Customer.Uebertrag:=0D;
Customer.Biere:=0;
Customer.Limos:=0;
Customer.Rechnung:=0D;
Customer.BiereIsg:=0;
Customer.LimosIsg:=0;
Customer.Umsatz:=0D;
SetValue(BierListe,Customer);
New:=TRUE;
ELSE
DiaReturn:=OKABR;
END(*IF*);
ELSE
Next(BierListe);
New:=FALSE;
END(*IF*);
END(*IF*); (*DiaRet=?*)
ELSIF EqualStr(Customer.Name,NewStr) THEN
FormRet:=FormAlert(2,AlertString6);
IF FormRet=2 THEN
RemoveElement(BierListe);
New:=FALSE
ELSE
DiaReturn:=NEXT;(* ~OKABR *)
END(*IF*);
ELSE (* Valid Input ? *)
FormRet:=FormAlert(1,AlertString1);
END(*IF*);
END(*IF*); (*DiaRet#Cancel*)
UNTIL DiaReturn=OKABR;
END Editiere;
BEGIN
AlertString1 :='[3][Sie haben einen|falschen Namen eingegeben][Nochmal]';
AlertString2 :='[1][Erster Eintrag!|Es gibt keinen|Vorgänger][ OK ]';
AlertString3 :='[2][Letzter Eintrag|Neuen Kunden hinzufügen?][ Ja | Nein ]';
AlertString5 :='[2][ Eintrag|wirklich löschen?][ Ja | Nein ]';
AlertString4 :='[3][Der Name wurde geändert|Neuen Namen Verwenden?][ Ja | Nein ]';
AlertString6 :='[2][Sie haben einen|falschen Namen eingegeben|Eingabe wiederholen?][ Ja | Nein ]';
NewStr:='Neuer Kunde';
AnfangsUebertrag:=0D;
MakeList(BierListe);
END EdiereBierListe.